home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / umich / tex / dvi / dvipssrc.zoo / ps / tex.lpr < prev    next >
Text File  |  1991-01-26  |  10KB  |  332 lines
  1. % The following defines procedures assumed and used by program "dvips"
  2. % and must be downloaded or sent as a header file for all TeX jobs.
  3. % Originated by Neal Holtz, Carleton University, Ottawa, Canada
  4. %      <holtz@cascade.carleton.cdn>
  5. %      June, 1985
  6. %
  7. %   Hacked by tgr, July 1987, stripped down to bare essentials,
  8. %   plus a few new commands for speed.
  9. %
  10. %   Hacked by don, December 1989, to give characters top down and to
  11. %   remove other small nuisances; merged with tgr's compression scheme
  12. %
  13. % To convert this file into a downloaded file instead of a header
  14. % file, uncomment all of the lines beginning with %-%
  15. %
  16. %   To observe available VM, uncomment the following.
  17. %   (The first ten lines define a general 'printnumber' routine.)
  18. %
  19. % /VirginMtrx 6 array currentmatrix def
  20. % /dummystring 20 string def
  21. % /numberpos 36 def
  22. % /printnumber { gsave VirginMtrx setmatrix
  23. %   /Helvetica findfont 10 scalefont setfont
  24. %   36 numberpos moveto
  25. %   /numberpos numberpos 12 add def
  26. %   dummystring cvs show
  27. %   grestore
  28. %   } bind def
  29. % /showVM { vmstatus exch sub exch pop printnumber } def
  30. % /eop-aux { showVM } def
  31. %
  32. %-%0000000             % Server loop exit password
  33. %-%serverdict begin exitserver
  34. %-%  systemdict /statusdict known
  35. %-%  {statusdict begin 9 0 3 setsccinteractive /waittimeout 300 def end}
  36. %-% if
  37.  
  38. /TeXDict 200 dict def   % define a working dictionary
  39. TeXDict begin           % start using it.
  40. /N /def load def
  41. /B { bind def } N
  42. /S /exch load def
  43. /X { S N } B
  44. /TR /translate load N
  45.  
  46. % The output of dvips assumes pixel units, Resolution/inch, with
  47. % increasing y coordinates corresponding to moving DOWNWARD.
  48. % The PostScript default is big point units (bp), 72/inch, with
  49. % increasing y coordinates corresponding to moving UP; the
  50. % following routines handle conversion to dvips conventions. 
  51.  
  52. % Let the PostScript origin be (xps,yps) in dvips coordinates.
  53.  
  54. /isls false N
  55. /vsize 10 N
  56.  
  57. /@rigin                 % -xps -yps @rigin -   establishes dvips conventions
  58.   { isls { [ 0 1 -1 0 0 0 ] concat } if
  59.     72 Resolution div 72 VResolution div neg scale
  60.     Resolution VResolution vsize neg mul TR
  61. % As bad as setmatrix is, it is better than misalignment.
  62.     matrix currentmatrix
  63.     dup dup 4 get round 4 exch put
  64.     dup dup 5 get round 5 exch put
  65.     setmatrix } N
  66.  
  67. % Here we assume the PostScript origin is at the bottom left corner
  68. % and that the paper is 11 inches high;
  69. % the dvips origin is 1 inch from top left corner;
  70. % hence if Resolution=300, we have (xps,yps)=(-300,3000). 
  71.  
  72. /@letter { /vsize 10 N } B
  73.  
  74. /@landscape { /isls true N /vsize -1 N } B
  75.  
  76. /@a4 { /vsize 10.6929133858 N } B
  77.  
  78. /@a3 { /vsize 15.5531 N } B
  79.  
  80. /@ledger { /vsize 16 N } B
  81.  
  82. /@legal { /vsize 13 N } B
  83.  
  84. /@manualfeed
  85.    { statusdict /manualfeed true put
  86.    } B
  87.  
  88.         % n @copies -   set number of copies
  89. /@copies
  90.    { /#copies X
  91.    } B
  92.  
  93. % Bitmap fonts are called Fa, Fb, ..., Fz, F0, F1 . . . Ga . . .
  94. % The calling sequence for downloading font foo is
  95. %           /foo df chardef1 ... chardefn E 
  96. % where each chardef is
  97. %           <hexstring> wd ht xoff yoff dx charno D 
  98. %  or       <hexstring> wd ht xoff yoff dx I
  99. %  or       <hexstring> charno D
  100. %  or       <hexstring> I
  101.  
  102. /FMat [1 0 0 -1 0 0] N
  103. /FBB [0 0 0 0] N
  104.  
  105. /nn 0 N /IE 0 N /ctr 0 N
  106. /df-tail       % id numcc maxcc df-tail -- initialize a new font dictionary
  107.   {
  108. %   dmystr 2 fontname cvx (@@@@) cvs putinterval  % put name in template
  109.     /nn 8 dict N              % allocate new font dictionary
  110.     nn begin
  111.         /FontType 3 N
  112.     /FontMatrix fntrx N
  113.     /FontBBox FBB N
  114.         string /base X
  115.         array /BitMaps X
  116.         /BuildChar {CharBuilder} N
  117.         /Encoding IE N
  118.         end
  119.     dup { /foo setfont }          %  dummy macro to be filled in
  120.        2 array copy cvx N         %  have to allocate a new one
  121.     load                          %  now we change it
  122. %      0 dmystr 6 string copy       %  get a copy of the font name
  123.        0 nn put
  124. %      cvn cvx put                  %  and stick it in the dummy macro
  125.     /ctr 0 N                      %  go, count, and etc.
  126.     [                               %  start next char definition
  127.   } B
  128. /df {
  129.    /sf 1 N
  130.    /fntrx FMat N
  131.    df-tail
  132. } B
  133. /dfs { div /sf X
  134.    /fntrx [ sf 0 0 sf neg 0 0 ] N
  135.    df-tail
  136. } B
  137.  
  138. /E { pop nn dup definefont setfont } B
  139.  
  140. % the following is the only character builder we need.  it looks up the
  141. % char data in the BitMaps array, and paints the character if possible.
  142. % char data  -- a bitmap descriptor -- is an array of length 6, of
  143. %          which the various slots are:
  144.  
  145. /ch-width {ch-data dup length 5 sub get} B % the number of pixels across
  146. /ch-height {ch-data dup length 4 sub get} B % the number of pixels tall
  147. /ch-xoff  {128 ch-data dup length 3 sub get sub} B % num pixels right of origin
  148. /ch-yoff  {ch-data dup length 2 sub get 127 sub} B % number of pixels below origin
  149. /ch-dx  {ch-data dup length 1 sub get} B     % number of pixels to next character
  150. /ch-image {ch-data dup type /stringtype ne
  151.       { ctr get /ctr ctr 1 add N } if
  152.    } B                        % the hex string image, or array of same
  153. %      /id ch-image N                          % image data
  154. /id 0 N /rw 0 N /rc 0 N /gp 0 N /cp 0 N /G 0 N /sf 0 N
  155.  
  156. /CharBuilder    % fontdict ch Charbuilder -     -- image one character
  157.      {save 3 1 roll S dup /base get 2 index get S /BitMaps get S get
  158.       /ch-data X pop
  159.       /ctr 0 N
  160.       ch-dx 0 ch-xoff ch-yoff ch-height sub
  161.       ch-xoff ch-width add ch-yoff
  162.       setcachedevice
  163.       ch-width ch-height true
  164.       [1 0 0 -1 -.1 ch-xoff sub ch-yoff .1 add]
  165. % begin code for uncompressed fonts only
  166.       {ch-image} imagemask
  167.       restore
  168.   } B
  169. % end code for uncompressed fonts only
  170. % % here's the alternate code for unpacking compressed fonts
  171. %      /id ch-image N                          % image data
  172. %      /rw ch-width 7 add 8 idiv string N      % row, initially zero
  173. %      /rc 0 N                                 % repeat count
  174. %      /gp 0 N                                 % image data pointer
  175. %      /cp 0 N                                 % column pointer
  176. %      { rc 0 ne { rc 1 sub /rc X rw } { G } ifelse } imagemask
  177. %    restore
  178. % } B
  179. % /G { { id gp get /gp gp 1 add N
  180. %   dup 18 mod S 18 idiv pl S get exec } loop } B
  181. % /adv { cp add /cp X } B
  182. % /chg { rw cp id gp 4 index getinterval putinterval
  183. %         dup gp add /gp X adv } B
  184. % /nd { /cp 0 N rw exit } B
  185. % /lsh { rw cp 2 copy get dup 0 eq { pop 1 } { dup 255 eq { pop 254 }
  186. %     { dup dup add 255 and S 1 and or } ifelse } ifelse put 1 adv } B
  187. % /rsh { rw cp 2 copy get dup 0 eq { pop 128 } { dup 255 eq { pop 127 }
  188. %     { dup 2 idiv S 128 and or } ifelse } ifelse put 1 adv } B
  189. % /clr { rw cp 2 index string putinterval adv } B
  190. % /set { rw cp fillstr 0 4 index getinterval putinterval adv } B
  191. % /fillstr 18 string 0 1 17 { 2 copy 255 put pop } for N
  192. % /pl [
  193. %    { adv 1 chg } bind
  194. %    { adv 1 chg nd } bind
  195. %    { 1 add chg } bind
  196. %    { 1 add chg nd } bind
  197. %    { adv lsh } bind
  198. %    { adv lsh nd } bind
  199. %    { adv rsh } bind
  200. %    { adv rsh nd } bind
  201. %    { 1 add adv } bind
  202. %    { /rc X nd } bind
  203. %    { 1 add set } bind
  204. %    { 1 add clr } bind
  205. %    { adv 2 chg } bind
  206. %    { adv 2 chg nd } bind
  207. %    { pop nd } bind ] N
  208. % % end of code for unpacking compressed fonts
  209.  
  210.                % in the following, the font-cacheing mechanism requires that
  211.                 % a name unique in the particular font be generated
  212.  
  213. /D            % char-data ch D -    -- define character bitmap in current font
  214.   { /cc X
  215.     dup type /stringtype ne {]} if
  216.     nn /base get cc ctr put
  217.     nn /BitMaps get S ctr S
  218.     sf 1 ne {
  219.        dup dup length 1 sub dup 2 index S get sf div put
  220.     } if
  221.     put
  222.     /ctr ctr 1 add N
  223.   } B
  224.  
  225. /I            % a faster D for when the next char follows immediately
  226.   { cc 1 add D } B
  227.  
  228. /bop           % bop -              -- begin a brand new page
  229.   {
  230.     userdict /bop-hook known { bop-hook } if
  231.     /SI save N
  232.     @rigin
  233.     0 0 moveto
  234.   } N
  235.  
  236. /eop           % - eop -              -- end a page
  237.   { % eop-aux  % -- to observe VM usage
  238.     clear SI restore
  239.     showpage
  240.     userdict /eop-hook known { eop-hook } if
  241.   } N
  242.  
  243. /@start         % - @start -            -- start everything
  244.   {
  245.     userdict /start-hook known { st